home *** CD-ROM | disk | FTP | other *** search
/ EnigmA Amiga Run 1996 February / EnigmA AMIGA RUN 04 (1996)(G.R. Edizioni)(IT)[!][issue 1996-02][Skylink CD III].iso / earcd / util1 / repack34.lha / Repack.rexx.BBS < prev    next >
File List  |  1995-12-14  |  16KB  |  652 lines
  1. /*             Welcome, dumper!
  2. LHA-LZX V1.0-2.0 by Mat Bettinson of the Plot Hatching Factory '95
  3. LHA-LZX V3.0 and above by Andrea Vallinotto.
  4.  
  5. $VER: LZX Repacker V 3.4_C-net, by Andrea Vallinotto (14.12.95)
  6. © 1995 Nathan Johnes Software lavatories :->
  7.  
  8. ************ SPECIAL BBS VERSION FOR C-Net and other BBS systems **************
  9.  
  10. Since Jonathan Forbes' brilliant LZX came along and promptly blew LHA away,
  11. there's a need for a bulk converter. This is such a device.
  12.  
  13. You can execute this script with the following parameters: destination
  14. directory (any valid path name), temp directory (as above), efficiency
  15. (either 1, 2 or 3), BBS mode ('on' or any other string for 'off').
  16. If you wish, you can change the value of the LZX merging-group in the
  17. beginning of the program (see below!).
  18.  
  19. C-Net suggested string:
  20. 'rx repack.rexx <source-file-name> <temp-dir> 3 ON'
  21. On C-Net repack is useful if used in the 'transform' operation that occours just
  22. after the upload of a file (after the test). Keep in mind that no matter which
  23. format the file is, after the repacking you'll have a LZX archive.
  24.  
  25. BEWARE: the temp dir must be large enough to accommodate the largest extracted
  26. archive you're converting (including sub-archives, if present!).
  27.  
  28. You'll need:
  29. in your search path: for lha and lzh archives either Lha, Lhx or LZX registered;
  30.              for tar archives either Tar, Gnutar or Detar,
  31.              and unzip, unarj, unrar, hpack, shrink, xarc, zoo, arc,
  32.              gzip, LZX, Delete, Assign, Setdate, Filenote and Which.
  33.  
  34. Since this version, LZX version 1.21 or above is REQUIRED!
  35.  
  36. You can change the following value to suit you needs! It's the maximum group
  37. size that LZX can create. */
  38.  
  39. groupsize=2900
  40.  
  41. /* Don't modify nothing below this line: spaghetti code lies behind...
  42.         DON'T SAY YOU'VE NOT BEEN WARNED!! 
  43. (But what kind of code would you expect from an Italian, anyway ? :-)) ) */
  44.  
  45. options results
  46. options failat 9
  47. signal on break_c
  48. signal on halt
  49.  
  50. verstring='LZX Repacker version 3.4_C-Net'
  51. parse var verstring jf utilname blah ver .
  52. titlestring=left(utilname,6) ver
  53. copyleft='by Andrea Vallinotto of Nowhere software'
  54. lstring="#?.(LZH|LHA|ZIP|ARJ|RAR|SHR|XAR|HPK|ARC|ZOO|PAK|TAR|GZ|Z|TGZ)"
  55. logname='t:Repack.log'
  56. anofile='s:repack.ano'
  57. cr='0a'x
  58. bold='1b'x'[1m'
  59. normal='1b'x'[0m'
  60. under='1b'x'[4m'
  61.  
  62. setuplib("rexxsupport.library",0,-30,0)
  63. parse source . . . scriptname . .
  64. if ~exists(scriptname) then signal badinstall
  65. call checklzx
  66.  
  67. parse arg instring
  68.  
  69. hmq=length(instring)-length(compress(instring,'"'))
  70. select
  71.     when hmq // 2 then signal baddata
  72.     when hmq=0 then do
  73.             parse var instring Dir root mode bbsmode quiet .
  74.             signal init
  75.             end
  76.     otherwise nop
  77. end
  78.  
  79. a=0
  80. loop:
  81. instring=strip(instring,L)
  82. a=a+1
  83. select
  84.     when left(instring,1)='"' then do
  85.                 parse var instring '"' foo.a '"' instring
  86.                 signal loop
  87.                 end
  88.     when left(instring,1)="" then do
  89.                 foo.0=a-1
  90.                 signal complete
  91.                 end
  92.     otherwise         do
  93.                 parse var instring foo.a instring
  94.                 signal loop
  95.                 end
  96. end
  97. complete:
  98. if foo.0>0 then dir= foo.1
  99.         else dir=''
  100. if foo.0>1 then root= foo.2
  101.         else root=''
  102. if foo.0>2 then mode= foo.3
  103.         else mode=''
  104. if foo.0>3 then bbsmode= foo.4
  105.         else bbsmode=''
  106. if foo.0>4 then quiet= foo.5
  107.         else quiet=''
  108. init:
  109. bbsmode=upper(bbsmode)
  110. if lzxreg then maxeff=9
  111.         else maxeff=3
  112. if (mode > maxeff | mode < 0) then signal baddata
  113.  
  114. if quiet ='' then     do
  115.             say;say ' *** LHA-LZX repacker 1.0-2.0 by Mat Bettinson of the Plot Hatching Factory ***'
  116.             say '   *** 'verstring copyleft '***';say
  117.             end
  118.  
  119. oldstack=Pragma('S',50000)
  120. If right(root,1) ~= '/' & right(root,1) ~= ':' then root = root'/'
  121.  
  122. /* this procedure must be left even in SFM because it could be called while
  123. recursing on a single file (on dir/RTD) */
  124. bestia=whatis(dir)
  125. select
  126.     when bestia='' then signal baddata
  127.     when bestia='FILE' then sfm(dir)
  128.     otherwise sfm=0
  129. end
  130. call initlog('on directory' dir)
  131. If right(Dir,1) ~= '/' & right(Dir,1) ~= ':' then Dir = Dir'/'
  132. if ~(length(root)-length(compress(root,':'))) then root=pragma(d)'/'root
  133. tempdir=root'RTD'
  134. mkdir(tempdir)
  135. if ~(length(dir)-length(compress(dir,':'))) then 
  136.                         if right(pragma(d),1)=':' then dir=pragma(d)dir
  137.                                     else dir=pragma(d)'/'dir
  138.                         else
  139.                         if dir=':' then dir=pragma(d)
  140. if bbsmode='ON' then do
  141.             Address COMMAND 'List 'quote(dir)' P 'lstring' DATES TO 'quote(root'lha-lzx_infos.temp')' FILES LFORMAT "%d %t %c"'
  142.             Call Open(infos,root'lha-lzx_infos.temp','R')
  143.             end
  144. if exists(quiet'recursive_LZX_repack.temp') then    Call Open(list,quiet'recursive_LZX_repack.temp','R')
  145.                             else do
  146.                             Address COMMAND "List "quote(Dir)" P "lstring" TO "quote(root'LHA-LZX.temp')" FILES LFORMAT %n"
  147.                             Call Open(list,root'LHA-LZX.temp','R')
  148.                             end
  149. Call Pragma('D',tempdir)
  150. call Writelogoptions
  151.  
  152. /* Mainloop */
  153. BSave = 0
  154. mainloop:
  155. call initano
  156. DO forever
  157.     File = ReadLN(list)
  158.     IF EOF(list) then break
  159.     if bbsmode='ON' then do
  160.                 mix = ReadLN(infos)
  161.                 Datetime = subword(mix,1,2)
  162.                 Comment = quote(subword(mix,3))
  163.             end
  164.     NewFile = Left(File,lastpos('.',file))'LZX'
  165.     say 'Converting file: 'File
  166.     Midcleanup()
  167.     Lhasize=Size(Dir||File)
  168.     signal on failure
  169.     WriteLog('Trying to extract' file)
  170.     arctype=extract(Dir||File)
  171.     signal off failure
  172.     if arctype="???" then do
  173.                 Say "Cannot determine arc type... skipping!"
  174.                 WriteLog("Couldn't determine arc type of" File '...skipped!')
  175.                 iterate
  176.                 end
  177.     WriteLog('File' file 'extracted OK. Repacking...')
  178.     Address COMMAND 'List PAT 'lstring' FILES ALL LFORMAT %p%n >'quote(root'recursive_LZX_repack.temp')
  179.     if size(root'recursive_LZX_repack.temp') ~= 0 then do
  180.                             WriteLog('Started recursion for file' file)
  181.                             Close(log)
  182.                             Address REXX scriptname quote(tempdir) quote(tempdir) mode bbsmode quote(root)
  183.                             Call Open(log,logname,'A')
  184.                             end
  185.     Call fano
  186.     old=pragma(d,tempdir)
  187.     signal on failure
  188.     if lzxreg then lzxmode=mode' -Qf'
  189.             else lzxmode=mode
  190.     Address COMMAND 'LZX -r -e -a -M'groupsize' -'lzxmode' -F a 'quote(Dir||NewFile) '#?'
  191.     signal off failure
  192.     call pragma(d,old)
  193.     Lzxsize=Size(Dir||Newfile)
  194.         Diff = Lhasize - Lzxsize
  195.         Address COMMAND 'Delete >NIL: 'quote(Dir||File) 'FORCE'
  196.         if bbsmode='ON' then do
  197.                     Address COMMAND 'Setdate >NIL: 'quote(Dir||NewFile) Datetime
  198.                     Address COMMAND 'Filenote >NIL: 'quote(Dir||NewFile) Comment
  199.                     end
  200.                 else     Address COMMAND 'Filenote >NIL: 'quote(Dir||NewFile) quote('Repacked by' utilname ver 'from' arctype 'archive; gained:' diff 'bytes!')
  201.         say '* 'Diff' bytes saved on this 'arctype' archive!' ; say
  202.         WriteLog('Converted' file 'to' newfile ', gained' Diff 'bytes')
  203.     BSave = BSave + Diff
  204. END
  205. if bsave=0 then Bsave="Sorry, no"
  206. select
  207.     when quiet='ON' then WriteLog(verstring': finished repacking; total gain: 'Bsave 'bytes')
  208.     when quiet~=''    then WriteLog('Finished file recursion')
  209.     otherwise nop
  210. end
  211. Cleanup:
  212. Call PRAGMA('D',root)
  213. Call Close(list)
  214. Call Close(log)
  215. if bbsmode='ON' then Call Close(infos)
  216. Address COMMAND 'Delete >NIL: 'quote(tempdir)' ALL FORCE'
  217. call Delete(root'LHA-LZX.temp')
  218. call Delete(root'lha-lzx_infos.temp')
  219. call Delete(root'recursive_LZX_repack.temp')
  220. call pragma('s',oldstack)
  221. EXIT 0
  222.  
  223. sfm:
  224. /* Single file mode... */
  225. parse arg sngfile
  226. sfm=1
  227. /* deve dare fn e dir */
  228. fn=substr(sngfile,max(lastpos(':', sngfile),lastpos('/', sngfile)) +1)
  229. dir=left(arg(1),max(lastpos(':',sngfile),lastpos('/',sngfile)))
  230. if ~(length(dir)-length(compress(dir,':'))) then /* Nel dir non ci sono i : */
  231.                         if right(pragma(d),1)=':' then dir=pragma(d)dir /* Se siamo in root, dir=root||dir */
  232.                                     else dir=pragma(d)'/'dir /* Se non siamo in root, dir=cwd||/||dir */ 
  233.                         else
  234.                         if dir=':' then dir=pragma(d) /* Ci sono i : ma solo quelli! (siamo in root)*/
  235. call initlog('on file' dir||fn)
  236. call writelogoptions
  237. open(fake,root'lha-lzx.temp',W)
  238. writeln(fake,fn)
  239. close(fake)
  240. tempdir=root'RTD'
  241. Mkdir(tempdir)
  242. if bbsmode='ON' then do
  243.             Address COMMAND 'List 'quote(Dir||fn)' DATES FILES LFORMAT "%d %t %c" >'quote(root'lha-lzx_infos.temp')
  244.             Call Open(infos,root'lha-lzx_infos.temp','R')
  245.             end
  246. Call Pragma('D',tempdir)
  247. Call Open(list,root'LHA-LZX.temp','R')
  248. Bsave=0
  249. signal mainloop
  250.  
  251. midcleanup:
  252. Address COMMAND 'Delete >NIL: "'tempdir'/#?" ALL FORCE'
  253. return 1
  254.  
  255. badinstall:
  256. Say "Repack has been incorrectly installed! See the DOCS!"
  257. signal badexit
  258.  
  259. baddata:
  260. Say 'One or more of the parameters supplied on the command line is bogus!!!'
  261.  
  262. badexit:
  263. Say '"Computer, end program!"'
  264. exit 5
  265.  
  266. extract:
  267. parse arg fullname
  268. select
  269.     when checklha(fullname) then arc=extlha(quote(fullname))
  270.     when checkzip(fullname) then arc=extzip(quote(fullname))
  271.     when checkarj(fullname) then arc=extarj(quote(fullname))
  272.     when checkrar(fullname) then arc=extrar(quote(fullname))
  273.     when checkshr(fullname) then arc=extshr(quote(fullname))
  274.     when checkxar(fullname) then arc=extxar(quote(fullname))
  275.     when checkarc(fullname) then arc=extarc(quote(fullname))
  276.     when checkzoo(fullname) then arc=extzoo(quote(fullname))
  277.     when checkpak(fullname) then arc=extpak(quote(fullname))
  278.     when checktgz(fullname) then arc=exttgz(quote(fullname))
  279.     when checktar(fullname) then arc=exttar(quote(fullname))
  280.     when checkgzip(fullname) then arc=extgzip(quote(fullname))
  281.     when checkhpack(fullname) then arc=exthpack(quote(fullname))
  282.         otherwise arc="???"
  283. end
  284. return arc
  285.  
  286. extlha:
  287. lxc='lha -a -F -M x'
  288. if (lzxreg & lha_h_l(arg(1))~='02'x) then lxc='lzx -a -F x'
  289.                             else if pathexists('lhx') then lxc='lhx -a -F -M x'
  290. Address COMMAND lxc arg(1) '#?'
  291. return "LHA"
  292.  
  293. extzip: 
  294. rctest=2
  295. options failat rctest
  296. Address COMMAND 'unzip -a -q 'arg(1)
  297. options failat 9
  298. return "ZIP"
  299.  
  300. extarj: 
  301. rctest=20
  302. options failat rctest
  303. Address COMMAND 'unarj x 'arg(1)
  304. options failat 9
  305. return "ARJ"
  306.  
  307. extrar: 
  308. Address COMMAND 'unrar x 'arg(1)
  309. return "RAR"
  310.  
  311. extshr:
  312. Address COMMAND 'shrink x 'arg(1) /* Unable to test if extr. failed! */
  313. return "Shrink"
  314.  
  315. extxar: 
  316. address command 'xarc -x 'arg(1) /* Unable to test if extr. failed! */
  317. return "XARC"
  318.  
  319. exthpack: 
  320. Address COMMAND 'hpack x -DA -R 'arg(1) /* Unable to test if extr. failed! */
  321. return "Hpack"
  322.  
  323. extarc:
  324. Address COMMAND 'arc e 'arg(1)
  325. return "ARC"
  326.  
  327. extzoo:
  328. rctest=1
  329. options failat rctest
  330. Address COMMAND 'zoo eq/ 'arg(1)
  331. options failat 9
  332. return "ZOO"
  333.  
  334. exttgz:
  335. extgzip(arg(1))
  336. exttar(exitname)
  337. call delete(exitname)
  338. return "Tar-Gzipped"
  339.  
  340. extgzip:
  341. sss = Left(file,(lastpos('.',file)-1))
  342. exitname=tempdir'/'||(right(sss,(length(sss)-lastpos('/',sss))))
  343. rctest=1
  344. options failat rctest
  345. Address COMMAND 'gzip >'quote(exitname) '-cd 'arg(1)
  346. drop sss;options failat 9
  347. return "GZip"
  348.  
  349. exttar:
  350. rctest=3
  351. if pathexists('gnutar') then txc='gnutar -p -x -f'
  352.             else if pathexists('tar') then txc='tar -a -x -f'
  353.                             else do
  354.                                 txc='detar'
  355.                                 rctest=9
  356.                                 end
  357. options failat rctest
  358. Address command txc arg(1)
  359. options failat 9
  360. drop txc;return 'TAR'
  361.  
  362. extpak:
  363. Address COMMAND arg(1)
  364. return "PAK"
  365.  
  366. checklha: 
  367. call open(check,arg(1),r)
  368. seek(check,2,B)
  369. if readch(check,3)=="-lh" then     do 
  370.                 close(check)
  371.                 return 1
  372.                 end
  373. close(check) 
  374. return 0
  375.  
  376. lha_h_l:
  377. call open(headercheck,(strip(arg(1),B,'"')),r)
  378. seek(headercheck,20,B)
  379. val=readch(headercheck,1)
  380. close(headercheck)
  381. return val
  382.  
  383. checkzip: 
  384. call open(check,arg(1),r)
  385. if readch(check,2)=="PK" then do
  386.                 close(check)
  387.                 return 1
  388.                 end
  389. close(check)
  390. return 0
  391.  
  392. checkarj: 
  393. call open(check,arg(1),r)
  394. if readch(check,2)=="`ê" then do
  395.                 close(check)
  396.                 return 1
  397.                 end
  398. close(check)
  399. return 0
  400.  
  401. checkrar: 
  402. call open(check,arg(1),r)
  403. if readch(check,3)=="Rar" then do
  404.                 close(check)
  405.                 return 1
  406.                 end
  407. close(check)
  408. return 0
  409.  
  410. checkshr:
  411. return (checkxar(arg(1)) & (right(arg(1),(length(arg(1))-lastpos('.',arg(1))))='shr'))
  412.  
  413. checkxar: 
  414. call open(check,arg(1),r)
  415. if readch(check,4)=="FORM" & right(readch(check,8),4)=="CDAF" then do
  416.                 close(check)
  417.                 return 1
  418.                 end
  419. close(check) 
  420. return 0
  421.  
  422. checktgz:
  423. call open(check,arg(1),r)
  424. if ((upper(right(arg(1),3))='TGZ' | upper(right(arg(1),6))='TAR.GZ') & readch(check,3)=='1f8b08'x) then do
  425.                                 close(check)
  426.                                 return 1
  427.                                 end
  428. close(check)
  429. return 0
  430.  
  431.  
  432. checktar:
  433. open(ch,arg(1),r)
  434. call seek(ch,100) /* Moves up to the needed position*/
  435. /* Nooow... let's try with lots of triple checks including datatype() calls....*/
  436. select
  437.     when ~tlc(7) then signal notar
  438.     when ~tlc(7) then signal notar
  439.     when ~tlc(7) then signal notar
  440.     when ~tlc(30) then signal notar
  441. otherwise close(ch);return 1
  442. end
  443.  
  444. notar:
  445. close(ch);return 0
  446.  
  447. tlc:
  448. do arg(1)
  449. ts=readch(ch,1)
  450. if ~(ts==' ' | datatype(ts,N) ) then return 0
  451. end
  452. if readch(ch,1)=='0'x then return 1 /* The string is 0 terminated....*/
  453. return 0
  454.  
  455.  
  456. checkgzip: 
  457. call open(check,arg(1),r)
  458. if readch(check,3)=='1f8b08'x then do
  459.                 close(check)
  460.                 return 1
  461.                 end
  462. close(check)
  463. return 0
  464.  
  465. checkhpack: 
  466. call open(check,arg(1),r)
  467. if readch(check,4)=="HPAK" then do
  468.                 close(check)
  469.                 return 1
  470.                 end
  471. close(check)
  472. return 0
  473.  
  474. checkzoo: 
  475. call open(check,arg(1),r)
  476. if readch(check,4)=="ZOO " then do
  477.                 close(check)
  478.                 return 1
  479.                 end
  480. close(check)
  481. return 0
  482.  
  483. checkarc:
  484. call open(check,arg(1),r)
  485. if readch(check,2)=='1a08'x then do
  486.                 close(check)
  487.                 return 1
  488.                 end
  489. close(check)
  490. return 0
  491.  
  492. checkpak:
  493. call open(check,arg(1),r)
  494. call seek(check,248)
  495. if readch(check,11)=='dos.library' then do
  496.                 close(check)
  497.                 return 1
  498.                 end
  499. close(check)
  500. return 0
  501.  
  502. Size: procedure
  503. return word(statef(arg(1)),2)
  504.  
  505. fano:
  506. do id=1 to omit.0
  507. if length(omit.id)-length(compress(omit.id,'#?'))=0 then
  508.                             if ~exists(omit.id) then iterate
  509. address command 'delete >NIL:' quote(omit.id) 'FORCE'
  510. end
  511. do id=1 to add.0
  512. if ~exists(add.id) then iterate
  513. ADDRESS COMMAND 'Copy' add.id tempdir
  514. end
  515. return
  516.  
  517. initano:
  518. if ~exists(anofile) then do 
  519.                 add.0=0
  520.                 omit.0=0
  521.                 return
  522.             end
  523.  
  524. open(in,anofile,r)
  525. do until eof(in)
  526.     inline=readln(in)
  527.     if goodline(inline) then break
  528. end
  529. middle:
  530. select
  531.     when inline=='ADD:' then call addano
  532.     when inline=='OMIT:' then call omitano
  533. otherwise nop
  534. end
  535. if ~eof(in) then signal middle
  536. if ~datatype(add.0,'N') then add.0=0
  537. if ~datatype(omit.0,'N') then omit.0=0
  538. return
  539.  
  540. addano:
  541. count=0
  542. do forever
  543. inline=readln(in)
  544. if (eof(in) | inline=='OMIT:') then do
  545.                     add.0=count
  546.                     return
  547.                     end
  548. if goodline(inline) then do
  549.                 count=count+1;add.count=inline
  550.             end
  551. end
  552. return
  553.  
  554. omitano:
  555. count=0
  556. do forever
  557. inline=readln(in)
  558. if (eof(in) | inline=='ADD:') then do
  559.                     omit.0=count
  560.                     return
  561.                     end
  562. if goodline(inline) then do
  563.                     count=count+1;omit.count=inline
  564.             end
  565. end
  566. return
  567.  
  568.  
  569. goodline: procedure
  570. if (left(arg(1),1)==';' | arg(1)=='') then return 0
  571. return 1
  572.  
  573. failure:
  574. signal off failure
  575. if (RC=10 | RC=104 | RC=rctest) then do
  576.             Say bold"WARNING:"normal"Failed extracting "fullname" archive... skipping!"
  577.             midcleanup()
  578.             Writelog('Extraction error while unpacking' fullname 'archive... skipping!')
  579.             if sfm then exit(10)
  580.                 else signal mainloop
  581.             end
  582.     else do
  583.         Say bold"WARNING:"normal"Problem encountered while creating new LZX archive (not enough memory ?)."
  584.         Say "Keeping original "fullname" archive."
  585.         call delete(dir||Newfile)
  586.         midcleanup()
  587.         Writelog('Could not create new LZX archive; keeping' fullname 'archive.')
  588.         if sfm then exit(10)
  589.             else signal mainloop
  590.         end
  591.  
  592. setuplib: procedure
  593. parse arg library,v1,v2,v3
  594.  
  595. if(~show('l',library))then    do
  596.                 if(~addlib(library,v1,v2,v3))then    do
  597.                                     say "Could not open" library"! Aborting..."
  598.                                     exit 10
  599.                                     end
  600.                 end
  601. return 1
  602.  
  603. writelog:
  604. return WriteLN(log,date(e) time() arg(1))
  605.  
  606. initlog:
  607. om='W'
  608. if exists(logname) then om='A'
  609. open(log,logname,om)
  610. Writeln(log,cr)
  611. WriteLog('Started 'verstring arg(1))
  612. close(log)
  613. open(log,logname,'A')
  614. drop om;return
  615.  
  616. writelogoptions:
  617. return Writelog('Options: Efficency' mode', BBSmode:' bbsmode)
  618.  
  619. pathexists: procedure
  620. address command 'which >nil:' arg(1)
  621. if rc=5 then return 0
  622. return 1
  623.  
  624. whatis: procedure
  625. return word(statef(arg(1)),1)
  626.  
  627. checklzx:
  628. address command 'which >NIL: lzx'
  629. if rc=5 then signal misslzx
  630. lzxreg=exists('l:lzx.keyfile')
  631. return
  632.  
  633. misslzx:
  634. say "LZX is not in installed (or not in your search path)!"
  635. exit(205)
  636.  
  637. mkdir: procedure
  638. return makedir(arg(1))
  639.  
  640. quote: procedure
  641. return '"'arg(1)'"'
  642.  
  643. halt:
  644. break_c:
  645. signal off break_c
  646. signal off halt
  647. signal off failure
  648. Say "Yo, man! You pressed Control-c! Stopping execution...."
  649. Writelog('User pressed Control-C, aborting....')
  650. call midcleanup()
  651. signal cleanup
  652.